#lang racket

(require "syntax.rkt")
(require "scope-set.rkt")

(define (test-annotate sy)
  (parameterize ((scope (scope))
                 (binding-table (binding-table))
                 (environment (environment)))
    (let ((expanded (annotate/expand (syntax-add-scope sy top-scope))))
      expanded)))

(define (test sy)
  (print "------------") (newline)
  (parameterize ((scope (scope))
                 (binding-table (binding-table))
                 (environment (environment)))
    (let ((expanded (annotate/expand (syntax-add-scope sy top-scope))))
      (print-syntax expanded)
      (newline)
      (let ((serialized (serialize-syntax expanded)))
        (print serialized)
        (newline)
        (print (eval serialized))
        (newline)))))

(define t1 (datum->syntax '(lambda (x) (lambda (x) (if x x x)))))

(define t2 (datum->syntax
            '(let-syntax ((name (lambda (stx) (syntax-car (syntax-cdr stx)))))
               (name 1))))

(define t3 (datum->syntax
            '(let ([x 1])
               (let-syntax ([m (lambda (stx) #'x)])
                 (lambda (x)
                   (m))))))

(define (or-macro body)
  `(letrec-syntax ([or (lambda (stx)
                         (let ((args (syntax-cdr stx)))
                           (if (syntax-null? args)
                               #'#f
                               (if (syntax-null? (syntax-cdr args))
                                   (syntax-car args)
                                   #`(let ((tmp #,(syntax-car args)))
                                       (if tmp tmp (or . #,(syntax-cdr args))))))))])
     ,body))

(define t4 (datum->syntax `(let ([tmp 1]) ,(or-macro `(or 2 tmp)))))
(define t5 (datum->syntax (or-macro `(let ([tmp 1]) (or 2 tmp)))))
(define t6 (datum->syntax (or-macro `(let ([if 1]) (or 2 if)))))

(define t7 (datum->syntax
            '(letrec-syntax ([identity (lambda (stx)
                                         (let ((misc-id (syntax-car (syntax-cdr stx))))
                                           #`(lambda (x)
                                               (let ([#,misc-id 2])
                                                 x))))])
               ((identity x) 1))))

(define t8 (datum->syntax
            '(let-syntax ((test (lambda (stx)
                                  (let ((x (+ 1 2)))
                                    #`#,x))))
               (test))))

(define t9 (datum->syntax
             '(letrec-syntax
                  ((foo (lambda (stx)
                          (if (syntax-null? (syntax-cdr stx))
                              #'(bar)
                              #'(bar 1))))
                   (bar (lambda (stx)
                          (if (syntax-null? (syntax-cdr stx))
                              #'420
                              #'(foo)))))
                (foo 1))))

(define t10 (datum->syntax
            '(let ()
               (begin
                 (define-syntax define-identity
                   (lambda (stx)
                     (let ((id (syntax-car (syntax-cdr stx))))
                       #`(define #,id (lambda (x) x)))))
                 (define-identity f)
                 (f 5)))))

(define t11 (datum->syntax
             '(let ()
                (begin
                  (define-syntax define
                    (lambda (stx)
                      #`(define #,(syntax-car (syntax-cdr stx)) 2)))
                  (define x 1)
                  x))))

(define t12 (datum->syntax
             '(let-syntax ((foo
                            (lambda (stx)
                              #`(let ((#,(syntax-car (syntax-cdr stx)) 420))
                                  #,(syntax-car (syntax-cdr (syntax-cdr stx)))))))
                (foo bar bar))))

;; Helper for building tests involving the 'let-inc' macro
(define (let-inc-macro body)
  `(let-syntax ([let-inc (lambda (stx)
                           (let ([u (syntax-car (syntax-cdr stx))]
                                 [v (syntax-car (syntax-cdr (syntax-cdr stx)))])
                             #`(let ((#,u (+ 1 #,u))) #,v)))])
     ,body))

;; Helper for building tests involving the 'm' macro
(define (m-macro body)
  `(let-syntax ([m (lambda (stx)
                     (let ([y (syntax-car (syntax-cdr stx))])
                       #`(let-inc x (* x #,y))))])
     ,body))


(define t13 (datum->syntax `(let ([x 3]) ,(let-inc-macro (m-macro `(m x))))))

(define t14 (datum->syntax '(lambda (a) (begin 1 2 a))))

(define t15
  (datum->syntax
   '(let-syntax ((with-one
                  (lambda (stx)
                    #`(let ((#,(syntax-car (syntax-cdr stx)) 1))
                        . #,(syntax-cdr (syntax-cdr stx))))))
      (with-one f (+ f 1)))))

(define t16 (datum->syntax '((lambda () (begin (define a 1) a)))))

(define t18-code
  '(let ()
       (begin
         (define-syntax begin-scope
           (lambda (stx)
             (let ((defer (syntax-car (syntax-cdr stx)))
                   (<body> (syntax-cdr (syntax-cdr stx))))
               #`(let ((stuff (list)))
                   (begin
                     (let-syntax ((#,defer (lambda (stx)
                                             (let ((<statement> (syntax-car (syntax-cdr stx))))
                                               #`(set! stuff (cons #,<statement> stuff))))))
                       (begin . #,<body>))
                     (for-each display stuff))))))
         (define example-1
           (lambda ()
             (begin-scope defer
                          (display "one")
                          (display "two")
                          (display "three"))))
         (define example-2
           (lambda ()
             (begin-scope defer
                          (display "one")
                          (defer (display "two"))
                          (display "three"))))

         (example-1)
         (example-2))))

(define t18 (datum->syntax t18-code))

(test t1)
(test t2)
(test t3)
(test t4)
(test t4)
(test t5)
(test t6)
(test t7)
;(test t8)
(test t9)
(test t10)
;(test t11)
(test t12)
(test t13)
(test t14)
(test t15)
(test t16)
(test t18)
